home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch17 / Face.cls < prev    next >
Text File  |  1999-07-06  |  17KB  |  549 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "RayFace"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. ' A face of a solid in a plane.
  17.  
  18. Implements RayTraceable
  19.  
  20. Private NumPoints As Integer
  21. Private Points() As Point3D ' Vertices
  22.  
  23. ' Ambient light parameters.
  24. Private AmbientKr As Single
  25. Private AmbientKg As Single
  26. Private AmbientKb As Single
  27.  
  28. ' Diffuse light parameters.
  29. Private DiffuseKr As Single
  30. Private DiffuseKg As Single
  31. Private DiffuseKb As Single
  32.  
  33. ' Specular reflection parameters.
  34. Private SpecularN As Single
  35. Private SpecularK As Single
  36.  
  37. ' Reflected light parameters.
  38. Private ReflectedKr As Single
  39. Private ReflectedKg As Single
  40. Private ReflectedKb As Single
  41.  
  42. ' Refracted light parameters.
  43. Private TransN As Single
  44. Private n1 As Single   ' Index of refraction outside the object.
  45. Private n2 As Single   ' Index of refraction inside the object.
  46. Private TransmittedKr As Single
  47. Private TransmittedKg As Single
  48. Private TransmittedKb As Single
  49.  
  50. Private IsReflective As Boolean
  51. Private IsTransparent As Boolean
  52. Private DoneOnThisScanline As Boolean
  53.  
  54. ' We had a hit on this scanline.
  55. Private HadHit As Boolean
  56.  
  57. ' We have had a hit on a previous scanline.
  58. Private HadHitOnPreviousScanline As Boolean
  59.  
  60. ' We will not be visible on later scanlines.
  61. Private ForeverCulled As Boolean
  62. ' Return an appropriate color for this object.
  63. Private Function GetColor() As Long
  64. Dim R As Integer
  65. Dim G As Integer
  66. Dim B As Integer
  67.  
  68.     R = 255 * (DiffuseKr + AmbientKr): If R > 255 Then R = 255
  69.     G = 255 * (DiffuseKg + AmbientKg): If G > 255 Then G = 255
  70.     B = 255 * (DiffuseKb + AmbientKb): If B > 255 Then B = 255
  71.     GetColor = RGB(R, G, B)
  72. End Function
  73. ' Return the right shade for this polygon.
  74. Private Function GetShade(ByVal pgon As SimplePolygon) As Long
  75. Dim i As Integer
  76. Dim px As Single
  77. Dim py As Single
  78. Dim pz As Single
  79. Dim light_source As LightSource
  80. Dim total_r As Single
  81. Dim total_g As Single
  82. Dim total_b As Single
  83. Dim R1 As Integer
  84. Dim g1 As Integer
  85. Dim b1 As Integer
  86. Dim empty_objects As Collection
  87.  
  88.     With pgon
  89.         ' Find a central point on this polygon.
  90.         For i = 1 To .PointX.Count
  91.             px = px + .PointX(i)
  92.             py = py + .PointY(i)
  93.             pz = pz + .PointZ(i)
  94.         Next i
  95.         px = px / .PointX.Count
  96.         py = py / .PointX.Count
  97.         pz = pz / .PointX.Count
  98.  
  99.         ' Add up the light components.
  100.         Set empty_objects = New Collection
  101.         For Each light_source In LightSources
  102.             CalculateHitColorDSA _
  103.                 1, empty_objects, Nothing, _
  104.                 EyeX, EyeY, EyeZ, _
  105.                 px, py, pz, .Nx, .Ny, .Nz, _
  106.                 DiffuseKr, DiffuseKg, DiffuseKb, AmbientKr, AmbientKg, AmbientKb, _
  107.                 SpecularK, SpecularN, R1, g1, b1
  108.             total_r = total_r + R1
  109.             total_g = total_g + g1
  110.             total_b = total_b + b1
  111.         Next light_source
  112.     End With
  113.  
  114.     If total_r > 255 Then total_r = 255
  115.     If total_g > 255 Then total_g = 255
  116.     If total_b > 255 Then total_b = 255
  117.  
  118.     GetShade = RGB(total_r, total_g, total_b)
  119. End Function
  120.  
  121. ' Return the unit surface normal.
  122. Private Sub GetUnitNormal(ByRef Nx As Single, ByRef Ny As Single, ByRef Nz As Single)
  123. Dim v1x As Single
  124. Dim v1y As Single
  125. Dim v1z As Single
  126. Dim v2x As Single
  127. Dim v2y As Single
  128. Dim v2z As Single
  129. Dim n_len As Single
  130.  
  131.     v1x = Points(2).Trans(1) - Points(1).Trans(1)
  132.     v1y = Points(2).Trans(2) - Points(1).Trans(2)
  133.     v1z = Points(2).Trans(3) - Points(1).Trans(3)
  134.     v2x = Points(3).Trans(1) - Points(2).Trans(1)
  135.     v2y = Points(3).Trans(2) - Points(2).Trans(2)
  136.     v2z = Points(3).Trans(3) - Points(2).Trans(3)
  137.     m3Cross Nx, Ny, Nz, v1x, v1y, v1z, v2x, v2y, v2z
  138.  
  139.     n_len = Sqr(Nx * Nx + Ny * Ny + Nz * Nz)
  140.     Nx = Nx / n_len
  141.     Ny = Ny / n_len
  142.     Nz = Nz / n_len
  143. End Sub
  144.  
  145. ' Return true if the point is in the polygon.
  146. Private Function PointInside(ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Boolean
  147. Dim i As Integer
  148. Dim xok As Boolean
  149. Dim yok As Boolean
  150. Dim zok As Boolean
  151.  
  152.     ' See in which coordinates the points differ.
  153.     ' X coordinates.
  154.     xok = False
  155.     For i = 2 To NumPoints
  156.         If Points(i - 1).Trans(1) <> Points(i).Trans(1) _
  157.         Then
  158.             xok = True
  159.             Exit For
  160.         End If
  161.     Next i
  162.  
  163.     ' Y coordinates.
  164.     yok = False
  165.     For i = 2 To NumPoints
  166.         If Points(i - 1).Trans(2) <> Points(i).Trans(2) _
  167.         Then
  168.             yok = True
  169.             Exit For
  170.         End If
  171.     Next i
  172.  
  173.     ' Z coordinates.
  174.     zok = False
  175.     For i = 2 To NumPoints
  176.         If Points(i - 1).Trans(3) <> Points(i).Trans(3) _
  177.         Then
  178.             yok = True
  179.             Exit For
  180.         End If
  181.     Next i
  182.  
  183.     ' Test the appropriate projection.
  184.     If xok And yok Then
  185.         PointInside = PointInsideXY(X, Y)
  186.     ElseIf yok And zok Then
  187.         PointInside = PointInsideYZ(Y, Z)
  188.     ElseIf xok And zok Then
  189.         PointInside = PointInsideXZ(X, Z)
  190.     Else
  191.         PointInside = False
  192.     End If
  193. End Function
  194. ' Add non-backface polygons to this collection.
  195. Public Sub RayTraceable_GetPolygons(ByRef num_polygons As Integer, polygons() As SimplePolygon, ByVal shaded As Boolean)
  196. Dim i As Integer
  197. Dim pgon As SimplePolygon
  198.  
  199.     ' Make a polygon.
  200.     Set pgon = New SimplePolygon
  201.  
  202.     ' Add points to the polygon.
  203.     For i = 1 To NumPoints
  204.         With Points(i)
  205.             pgon.AddPoint .Trans(1), .Trans(2), .Trans(3)
  206.         End With
  207.     Next i
  208.  
  209.     ' See if we are shaded.
  210.     If shaded Then
  211.         ' We are shaded. Get the right color.
  212.         pgon.ForeColor = GetShade(pgon)
  213.         pgon.FillColor = pgon.ForeColor
  214.     Else
  215.         ' We are not shaded. Use the normal colors.
  216.         pgon.ForeColor = vbBlack
  217.         pgon.FillColor = GetColor()
  218.     End If
  219.  
  220.     ' Add the polygon to the list.
  221.     num_polygons = num_polygons + 1
  222.     ReDim Preserve polygons(1 To num_polygons)
  223.     Set polygons(num_polygons) = pgon
  224. End Sub
  225. ' Draw a wireframe for this object.
  226. Public Sub RayTraceable_DrawWireFrame(ByVal pic As PictureBox)
  227. Dim i As Integer
  228.  
  229.     ' Use an appropriate color.
  230.     pic.ForeColor = GetColor()
  231.  
  232.     ' Draw the polygon.
  233.     With Points(NumPoints)
  234.         pic.CurrentX = .Trans(1)
  235.         pic.CurrentY = .Trans(2)
  236.     End With
  237.     For i = 1 To NumPoints
  238.         With Points(i)
  239.             pic.Line -(.Trans(1), .Trans(2))
  240.         End With
  241.     Next i
  242. End Sub
  243. ' Initialize the object using text parameters in
  244. ' a comma-delimited list.
  245. Public Sub SetParameters(ByVal txt As String)
  246. Dim i As Integer
  247.  
  248.     On Error GoTo PolygonParamError
  249.  
  250.     ' Read the parameters and initialize the object.
  251.     ' Geometry.
  252.     NumPoints = CInt(GetDelimitedToken(txt, ","))
  253.     ReDim Points(1 To NumPoints)
  254.  
  255.     For i = 1 To NumPoints
  256.         With Points(i)
  257.             .Coord(1) = CSng(GetDelimitedToken(txt, ","))
  258.             .Coord(2) = CSng(GetDelimitedToken(txt, ","))
  259.             .Coord(3) = CSng(GetDelimitedToken(txt, ","))
  260.             .Coord(4) = 1
  261.         End With
  262.     Next i
  263.  
  264.     ' Ambient light.
  265.     AmbientKr = CSng(GetDelimitedToken(txt, ","))
  266.     AmbientKg = CSng(GetDelimitedToken(txt, ","))
  267.     AmbientKb = CSng(GetDelimitedToken(txt, ","))
  268.  
  269.     ' Diffuse reflection.
  270.     DiffuseKr = CSng(GetDelimitedToken(txt, ","))
  271.     DiffuseKg = CSng(GetDelimitedToken(txt, ","))
  272.     DiffuseKb = CSng(GetDelimitedToken(txt, ","))
  273.  
  274.     ' Specular reflection.
  275.     SpecularN = CSng(GetDelimitedToken(txt, ","))
  276.     SpecularK = CSng(GetDelimitedToken(txt, ","))
  277.  
  278.     ' Reflected light.
  279.     ReflectedKr = CSng(GetDelimitedToken(txt, ","))
  280.     ReflectedKg = CSng(GetDelimitedToken(txt, ","))
  281.     ReflectedKb = CSng(GetDelimitedToken(txt, ","))
  282.     IsReflective = (ReflectedKr > 0) Or (ReflectedKg > 0) Or (ReflectedKb > 0)
  283.  
  284.     ' Transmitted light.
  285.     TransN = CSng(GetDelimitedToken(txt, ","))
  286.     n1 = CSng(GetDelimitedToken(txt, ","))
  287.     n2 = CSng(GetDelimitedToken(txt, ","))
  288.     TransmittedKr = CSng(GetDelimitedToken(txt, ","))
  289.     TransmittedKg = CSng(GetDelimitedToken(txt, ","))
  290.     TransmittedKb = CSng(GetDelimitedToken(txt, ","))
  291.     IsTransparent = (TransmittedKr > 0) Or (TransmittedKg > 0) Or (TransmittedKb > 0)
  292.  
  293.     ' The polygon is its own wire frame.
  294.  
  295.     Exit Sub
  296.  
  297. PolygonParamError:
  298.     MsgBox "Error initializing polygon parameters."
  299. End Sub
  300.  
  301. ' Apply a transformation matrix to the object.
  302. Public Sub RayTraceable_Apply(M() As Single)
  303. Dim i As Integer
  304.  
  305.     ' Transform the points.
  306.     For i = 1 To NumPoints
  307.         m3Apply Points(i).Coord, _
  308.              M, Points(i).Trans
  309.     Next i
  310. End Sub
  311. ' Apply a transformation matrix to the object.
  312. Public Sub RayTraceable_ApplyFull(M() As Single)
  313. Dim i As Integer
  314.  
  315.     ' Transform the points.
  316.     For i = 1 To NumPoints
  317.         m3ApplyFull Points(i).Coord, _
  318.                  M, Points(i).Trans
  319.     Next i
  320. End Sub
  321.  
  322. ' Draw the object with backfaces removed.
  323. ' Draw the whole wire frame for planes.
  324. Public Sub RayTraceable_DrawBackfacesRemoved(ByVal pic As PictureBox)
  325.     RayTraceable_DrawWireFrame pic
  326. End Sub
  327. ' Return the red, green, and blue components of
  328. ' the surface at the hit position.
  329. Public Sub RayTraceable_FindHitColor(ByVal depth As Integer, Objects As Collection, ByVal eye_x As Single, ByVal eye_y As Single, ByVal eye_z As Single, ByVal px As Single, ByVal py As Single, ByVal pz As Single, ByRef R As Integer, ByRef G As Integer, ByRef B As Integer)
  330. Dim Nx As Single
  331. Dim Ny As Single
  332. Dim Nz As Single
  333.  
  334.     ' Find the unit normal at this point.
  335.     GetUnitNormal Nx, Ny, Nz
  336.  
  337.     ' Get the hit color.
  338.     CalculateHitColor depth, Objects, Me, _
  339.         eye_x, eye_y, eye_z, _
  340.         px, py, pz, _
  341.         Nx, Ny, Nz, _
  342.         DiffuseKr, DiffuseKg, DiffuseKb, _
  343.         AmbientKr, AmbientKg, AmbientKb, _
  344.         SpecularK, SpecularN, _
  345.         ReflectedKr, ReflectedKg, ReflectedKb, IsReflective, _
  346.         TransmittedKr, TransmittedKg, TransmittedKb, TransN, n1, n2, IsTransparent, _
  347.         R, G, B
  348. End Sub
  349. ' See if the scanline plane with the indicated
  350. ' point and normal intersects this object.
  351. '
  352. ' Do not cull. Note that this may not be a
  353. ' convex polygon.
  354. Public Sub RayTraceable_CullScanline(ByVal px As Single, ByVal py As Single, ByVal pz As Single, ByVal Nx As Single, ByVal Ny As Single, ByVal Nz As Single)
  355.     DoneOnThisScanline = False
  356. End Sub
  357. ' Return the value T for the point of intersection
  358. ' between the vector from point (px, py, pz) in
  359. ' the direction <vx, vy, vz>.
  360. '
  361. ' direct_calculation is true if we are finding the
  362. ' intersection from a viewing position ray. It is
  363. ' false if we are finding an reflected intersection
  364. ' or a shadow feeler.
  365. Public Function RayTraceable_FindT(ByVal direct_calculation As Boolean, ByVal px As Single, ByVal py As Single, ByVal pz As Single, ByVal Vx As Single, ByVal Vy As Single, ByVal Vz As Single) As Single
  366. Dim A As Single
  367. Dim B As Single
  368. Dim C As Single
  369. Dim D As Single
  370. Dim Nx As Single
  371. Dim Ny As Single
  372. Dim Nz As Single
  373. Dim denom As Single
  374. Dim t As Single
  375. Dim X As Single
  376. Dim Y As Single
  377. Dim Z As Single
  378.  
  379.     ' See if we have been culled.
  380.     If direct_calculation And DoneOnThisScanline Then
  381.         RayTraceable_FindT = -1
  382.         Exit Function
  383.     End If
  384.  
  385.     ' Find the unit normal at this point.
  386.     GetUnitNormal Nx, Ny, Nz
  387.  
  388.     ' Compute the plane's parameters.
  389.     A = Nx
  390.     B = Ny
  391.     C = Nz
  392.     D = -(Nx * Points(1).Trans(1) + _
  393.           Ny * Points(1).Trans(2) + _
  394.           Nz * Points(1).Trans(3))
  395.  
  396.     ' If the denominator = 0, the ray is parallel
  397.     ' to the plane so there's no intersection.
  398.     denom = A * Vx + B * Vy + C * Vz
  399.     If denom = 0 Then
  400.         RayTraceable_FindT = -1
  401.         Exit Function
  402.     End If
  403.  
  404.     ' Solve for t.
  405.     t = -(A * px + B * py + C * pz + D) / denom
  406.  
  407.     ' If there is no positive t value, there's no
  408.     ' intersection in this direction.
  409.     If t < 0.01 Then
  410.         RayTraceable_FindT = -1
  411.         Exit Function
  412.     End If
  413.  
  414.     ' Get the point of intersection with the plane.
  415.     X = px + t * Vx
  416.     Y = py + t * Vy
  417.     Z = pz + t * Vz
  418.  
  419.     ' See if the point is in the polygon.
  420.     If Not PointInside(X, Y, Z) Then
  421.         ' We are not in the polygon.
  422.         RayTraceable_FindT = -1
  423.         Exit Function
  424.     End If
  425.  
  426.     ' We had a hit.
  427.     If direct_calculation Then HadHit = True
  428.  
  429.     RayTraceable_FindT = t
  430. End Function
  431. ' Return true if the point's projection lies within
  432. ' this polygon's projection onto the X-Y plane.
  433. Private Function PointInsideXY(ByVal X As Single, ByVal Y As Single) As Boolean
  434. Dim i As Integer
  435. Dim theta1 As Double
  436. Dim theta2 As Double
  437. Dim dtheta As Double
  438. Dim dx As Double
  439. Dim dy As Double
  440. Dim angles As Double
  441.  
  442.     dx = Points(NumPoints).Trans(1) - X
  443.     dy = Points(NumPoints).Trans(2) - Y
  444.     theta1 = ATan2(CSng(dy), CSng(dx))
  445.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  446.     For i = 1 To NumPoints
  447.         dx = Points(i).Trans(1) - X
  448.         dy = Points(i).Trans(2) - Y
  449.         theta2 = ATan2(CSng(dy), CSng(dx))
  450.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  451.         dtheta = theta2 - theta1
  452.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  453.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  454.         angles = angles + dtheta
  455.         theta1 = theta2
  456.     Next i
  457.  
  458.     PointInsideXY = (Abs(angles) > 0.001)
  459. End Function
  460. ' Return true if the point's projection lies within
  461. ' this polygon's projection onto the X-Y plane.
  462. Private Function PointInsideXZ(ByVal X As Single, ByVal Z As Single) As Boolean
  463. Dim i As Integer
  464. Dim theta1 As Double
  465. Dim theta2 As Double
  466. Dim dtheta As Double
  467. Dim dx As Double
  468. Dim dz As Double
  469. Dim angles As Double
  470.  
  471.     dx = Points(NumPoints).Trans(1) - X
  472.     dz = Points(NumPoints).Trans(3) - Z
  473.     theta1 = ATan2(CSng(dz), CSng(dx))
  474.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  475.     For i = 1 To NumPoints
  476.         dx = Points(i).Trans(1) - X
  477.         dz = Points(i).Trans(3) - Z
  478.         theta2 = ATan2(CSng(dz), CSng(dx))
  479.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  480.         dtheta = theta2 - theta1
  481.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  482.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  483.         angles = angles + dtheta
  484.         theta1 = theta2
  485.     Next i
  486.  
  487.     PointInsideXZ = (Abs(angles) > 0.001)
  488. End Function
  489. ' Return true if the point projection lies within
  490. ' this polygon's projection onto the X-Z plane.
  491. Private Function PointInsideYZ(ByVal Y As Single, ByVal Z As Single) As Boolean
  492. Dim i As Integer
  493. Dim theta1 As Double
  494. Dim theta2 As Double
  495. Dim dtheta As Double
  496. Dim dy As Double
  497. Dim dz As Double
  498. Dim angles As Double
  499.  
  500.     dy = Points(NumPoints).Trans(2) - Y
  501.     dz = Points(NumPoints).Trans(3) - Z
  502.     theta1 = ATan2(CSng(dz), CSng(dy))
  503.     If theta1 < 0 Then theta1 = theta1 + 2 * PI
  504.     For i = 1 To NumPoints
  505.         dy = Points(i).Trans(2) - Y
  506.         dz = Points(i).Trans(3) - Z
  507.         theta2 = ATan2(CSng(dz), CSng(dy))
  508.         If theta2 < 0 Then theta2 = theta2 + 2 * PI
  509.         dtheta = theta2 - theta1
  510.         If dtheta > PI Then dtheta = dtheta - 2 * PI
  511.         If dtheta < -PI Then dtheta = dtheta + 2 * PI
  512.         angles = angles + dtheta
  513.         theta1 = theta2
  514.     Next i
  515.  
  516.     PointInsideYZ = (Abs(angles) > 0.001)
  517. End Function
  518. ' Return the minimum and maximum distances from
  519. ' this point.
  520. ' Use the points.
  521. Private Sub RayTraceable_GetRminRmax(new_min As Single, new_max As Single, ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
  522. Dim i As Integer
  523. Dim dx As Single
  524. Dim dy As Single
  525. Dim dz As Single
  526. Dim dist As Single
  527.  
  528.     new_min = 1E+30
  529.     new_max = -1E+30
  530.  
  531.     For i = 1 To NumPoints
  532.         With Points(i)
  533.             dx = X - .Trans(1)
  534.             dy = Y - .Trans(2)
  535.             dz = Z - .Trans(3)
  536.         End With
  537.         dist = Sqr(dx * dx + dy * dy + dz * dz)
  538.         If new_min > dist Then new_min = dist
  539.         If new_max < dist Then new_max = dist
  540.     Next i
  541. End Sub
  542. ' Reset the ForeverCulled flag.
  543. Private Sub RayTraceable_ResetCulling()
  544.     ForeverCulled = False
  545.     HadHitOnPreviousScanline = False
  546. End Sub
  547.  
  548.  
  549.